home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
UTILITY1
/
MSWLGO35.ZIP
/
EXAMPLES
/
STUDENT
< prev
next >
Wrap
Text File
|
1993-04-12
|
35KB
|
1,170 lines
;
; Function:
;
; Mathamatical word problem sovler.
;
; Load "student
; Call STUDENT [problem]
;
; Example: (many others at bottom)
;
; STUDENT :jet
;
TO ABS :NUM
OP IFELSE (:NUM < 0) [-:NUM] [:NUM]
END
TO AGEIFY :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT PERSONP FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]
CATCH "ERROR [IF EQUALP FIRST BF :SENT "S ~
[OUTPUT FPUT FIRST :SENT AGEIFY BF :SENT]]
OUTPUT (SE FIRST :SENT [S AGE] AGEIFY BF :SENT)
END
TO AGEPROB
LOCAL [BEG END SYM WHO NUM SUBJ AGES]
WHILE [MATCH [^BEG AS OLD AS #END] :PROB] [MAKE "PROB SE :BEG :END]
WHILE [MATCH [^BEG YEARS OLD #END] :PROB] [MAKE "PROB SE :BEG :END]
WHILE [MATCH [^BEG WILL BE WHEN #END] :PROB] ~
[MAKE "SYM GENSYM ~
MAKE "PROB (SE :BEG "IN :SYM [YEARS . IN] :SYM "YEARS :END)]
WHILE [MATCH [^BEG WAS WHEN #END] :PROB] ~
[MAKE "SYM GENSYM ~
MAKE "PROB (SE :BEG :SYM [YEARS AGO .] :SYM [YEARS AGO] :END)]
WHILE [MATCH [^BEG !WHO:PERSONP WILL BE IN !NUM YEARS #END] :PROB] ~
[MAKE "PROB (SE :BEG :WHO [S AGE IN] :NUM "YEARS #END)]
WHILE [MATCH [^BEG WAS #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
WHILE [MATCH [^BEG WILL BE #END] :PROB] [MAKE "PROB (SE :BEG "IS :END)]
WHILE [MATCH [^BEG !WHO:PERSONP IS NOW #END] :PROB] ~
[MAKE "PROB (SE :BEG :WHO [S AGE NOW] :END)]
WHILE [MATCH [^BEG !NUM YEARS FROM NOW #END] :PROB] ~
[MAKE "PROB (SE :BEG "IN :NUM "YEARS :END)]
MAKE "PROB AGEIFY :PROB
IFELSE MATCH [^ !WHO:PERSONP ^END S AGE #] :PROB ~
[MAKE "SUBJ SE :WHO :END] [MAKE "SUBJ "SOMEONE]
MAKE "PROB AGEPRON :PROB
MAKE "END :PROB
MAKE "AGES []
WHILE [MATCH [^ !WHO:PERSONP ^BEG AGE #END] :END] ~
[PUSH "AGES (SE "AND :WHO :BEG "AGE)]
MAKE "AGES BF REDUCE "SE REMDUP :AGES
WHILE [MATCH [^BEG THEIR AGES #END] :PROB] [MAKE "PROB (SE :BEG :AGES :END)]
MAKE "SIMSEN MAP [AGESEN ?] BRACKET :PROB
END
TO AGEPRON :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT PRONOUN FIRST :SENT [OUTPUT FPUT FIRST :SENT AGEPRON BF :SENT]
IF POSSPRO FIRST :SENT [OUTPUT (SE :SUBJ "S AGEPRON BF :SENT)]
OUTPUT (SE :SUBJ [S AGE] AGEPRON BF :SENT)
END
TO AGESEN :SENT
LOCAL [WHEN REST NUM]
MAKE "WHEN []
IF MATCH [IN !NUM YEARS #REST] :SENT ~
[MAKE "WHEN SE "PLUSS :NUM MAKE "SENT :REST]
IF MATCH [!NUM YEARS AGO #REST] :SENT ~
[MAKE "WHEN SE "MINUSS :NUM MAKE "SENT :REST]
OUTPUT AGEWHEN :SENT
END
TO AGEWHEN :SENT
IF EMPTYP :SENT [OUTPUT []]
IF NOT EQUALP FIRST :SENT "AGE [OUTPUT FPUT FIRST :SENT AGEWHEN BF :SENT]
IF MATCH [IN !NUM YEARS #REST] BF :SENT ~
[OUTPUT (SE [AGE PLUSS] :NUM AGEWHEN :REST)]
IF MATCH [!NUM YEARS AGO #REST] BF :SENT ~
[OUTPUT (SE [AGE MINUSS] :NUM AGEWHEN :REST)]
IF EQUALP "NOW FIRST BF :SENT [OUTPUT SE "AGE AGEWHEN BF BF :SENT]
OUTPUT (SE "AGE :WHEN AGEWHEN BF :SENT)
END
TO ARTICLE :WORD
OP MEMBERP :WORD [A AN THE]
END
TO BKT1 :PROBLIST
LOCAL [FIRST WORD REST]
IF EMPTYP :PROBLIST [OUTPUT []]
IF NOT MEMBERP ", FIRST :PROBLIST [OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST]
IF MATCH [IF ^FIRST , !WORD:QWORD #REST] FIRST :PROBLIST ~
[OP BKT1 FPUT (SE :FIRST ".) FPUT (SE :WORD :REST) BF :PROBLIST]
IF MATCH [^FIRST , AND #REST] FIRST :PROBLIST ~
[OP FPUT (SE :FIRST ".) (BKT1 FPUT :REST BF :PROBLIST)]
OP FPUT FIRST :PROBLIST BKT1 BF :PROBLIST
END
TO BRACKET :PROB
OUTPUT BKT1 FINDDELIM :PROB
END
TO CHANGEONE :CHANGE
LOCAL "END
IF NOT MATCH (SE FIRST :CHANGE [#END]) :SENT [OP "FALSE]
MAKE "SENT RUN (SE "SE LAST :CHANGE ":END)
OP "TRUE
END
TO CHANGES :SENT :LIST
LOCAL "KEYWORDS
MAKE "KEYWORDS MAP.SE [FINDKEY FIRST ?] :LIST
OP CHANGES1 :SENT :LIST :KEYWORDS
END
TO CHANGES1 :SENT :LIST :KEYWORDS
IF EMPTYP :SENT [OP []]
IF MEMBERP FIRST :SENT :KEYWORDS [OP CHANGES2 :SENT :LIST :KEYWORDS]
OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
END
TO CHANGES2 :SENT :LIST :KEYWORDS
CHANGES3 :LIST :LIST
OP FPUT FIRST :SENT CHANGES1 BF :SENT :LIST :KEYWORDS
END
TO CHANGES3 :BIGLIST :NOWLIST
IF EMPTYP :NOWLIST [STOP]
IF CHANGEONE FIRST :NOWLIST [CHANGES3 :BIGLIST :BIGLIST STOP]
CHANGES3 :BIGLIST BF :NOWLIST
END
TO DENOM :FRACT :ADDENDS
MAKE "ADDENDS SIMPLUS :ADDENDS
LOCAL "DEN
MAKE "DEN LAST :FRACT
IF NOT EQUALP FIRST :ADDENDS "QUOTIENT ~
[OP SIMDIV LIST ~
(SIMONE "SUM ~
(REMOP "SUM LIST (DISTRIBTIMES (LIST :ADDENDS) :DEN) ~
FIRST BF :FRACT)) :DEN]
IF EQUALP :DEN LAST :ADDENDS ~
[OP SIMDIV (SIMPLUS LIST (FIRST BF :FRACT) (FIRST BF :ADDENDS)) :DEN]
LOCAL "LOWTERMS
MAKE "LOWTERMS SIMDIV LIST :DEN LAST :ADDENDS
OP SIMDIV LIST (SIMPLUS (SIMTIMES LIST FIRST BF :FRACT LAST :LOWTERMS) ~
(SIMTIMES LIST FIRST BF :ADDENDS FIRST BF :LOWTERMS)) ~
(SIMTIMES LIST FIRST BF :LOWTERMS LAST :ADDENDS)
END
TO DEPUNCT :WORD
IF EMPTYP :WORD [OP []]
IF EQUALP FIRST :WORD "$ [OP SE "$ DEPUNCT BF :WORD]
IF EQUALP LAST :WORD "% [OP SE DEPUNCT BL :WORD "PERCENT]
IF MEMBERP LAST :WORD [. ? |;| ,] [OP SE DEPUNCT BL :WORD LAST :WORD]
IF EMPTYP BF :WORD [OP :WORD]
IF EQUALP LAST2 :WORD "'S [OP SE DEPUNCT BL BL :WORD "S]
OP :WORD
END
TO DISTRIBTIMES :TRMS :MULTIPLIER
OP SIMPLUS MAP [SIMTIMES (LIST ? :MULTIPLIER)] :TRMS
END
TO DISTRIBX :EXPR
LOCAL [OPER ARGS]
IF EMPTYP :EXPR [OP :EXPR]
MAKE "OPER FIRST :EXPR
IF NOT OPERATORP :OPER [OP :EXPR]
MAKE "ARGS MAP [DISTRIBX ?] BF :EXPR
IF REDUCE "AND MAP [NUMBERP ?] :ARGS [OP RUN (SE [(] :OPER :ARGS [)])]
IF EQUALP :OPER "SUM [OP SIMPLUS :ARGS]
IF EQUALP :OPER "MINUS [OP MINUSIN FIRST :ARGS]
IF EQUALP :OPER "PRODUCT [OP SIMTIMES :ARGS]
IF EQUALP :OPER "QUOTIENT [OP SIMDIV :ARGS]
OP FPUT :OPER :ARGS
END
TO DIVTERM :DIVIDEND :DIVISOR
IF EQUALP :DIVIDEND 0 [OP 0]
OP SIMDIV LIST :DIVIDEND :DIVISOR
END
TO DLM :WORD
OP MEMBERP :WORD [. ? |;|]
END
TO EXPT :NUM :POW
IF :POW < 1 [OP 1]
OP :NUM * EXPT :NUM :POW - 1
END
TO FACTOR :EXPRS :VAR
LOCAL "TRMS
MAKE "TRMS MAP [FACTOR1 :VAR ?] :EXPRS
IF MEMBERP "UNKNOWN :TRMS [OP FPUT "UNKNOWN :EXPRS]
OP LIST :VAR SIMPLUS :TRMS
END
TO FACTOR1 :VAR :EXPR
LOCAL "NEGVAR
MAKE "NEGVAR MINUSIN :VAR
IF EQUALP :VAR :EXPR [OP 1]
IF EQUALP :NEGVAR :EXPR [OP -1]
IF EMPTYP :EXPR [OP "UNKNOWN]
IF EQUALP FIRST :EXPR "PRODUCT [OP FACTOR2 BF :EXPR]
IF NOT EQUALP FIRST :EXPR "QUOTIENT [OP "UNKNOWN]
LOCAL "DIVIDEND
MAKE "DIVIDEND FIRST BF :EXPR
IF EQUALP :VAR :DIVIDEND [OP (LIST "QUOTIENT 1 LAST :EXPR)]
IF NOT EQUALP FIRST :DIVIDEND "PRODUCT [OP "UNKNOWN]
LOCAL "RESULT
MAKE "RESULT FACTOR2 BF :DIVIDEND
IF EQUALP :RESULT "UNKNOWN [OP "UNKNOWN]
OP (LIST "QUOTIENT :RESULT LAST :EXPR)
END
TO FACTOR2 :TRMS
IF MEMBERP :VAR :TRMS [OP SIMONE "PRODUCT (REMOVE :VAR :TRMS)]
IF MEMBERP :NEGVAR :TRMS [OP MINUSIN SIMONE "PRODUCT (REMOVE :NEGVAR :TRMS)]
OP "UNKNOWN
END
TO FINDDELIM :SENT
OP FINDDELIM1 :SENT [] []
END
TO FINDDELIM1 :IN :OUT :SIMPLES
IF EMPTYP :IN ~
[IFELSE EMPTYP :OUT [OP :SIMPLES] [OP LPUT (SE :OUT ".) :SIMPLES]]
IF DLM FIRST :IN ~
[OP FINDDELIM1 (BF :IN) [] (LPUT (SE :OUT FIRST :IN) :SIMPLES)]
OP FINDDELIM1 (BF :IN) (SE :OUT FIRST :IN) :SIMPLES
END
TO FINDKEY :PATTERN
IF EQUALP FIRST :PATTERN "!:IN [OP FIRST BF :PATTERN]
IF EQUALP FIRST :PATTERN "?:IN [OP SE (ITEM 2 :PATTERN) (ITEM 3 :PATTERN)]
OP FIRST :PATTERN
END
TO GETEQNS :VARS
OP MAP.SE [GPROP VARKEY ? "EQNS] :VARS
END
TO IDIOMS :SENT
LOCAL "NUMBER
OP CHANGES :SENT ~
[[[THE SUM OF] ["SUM]] [[SQUARE OF] ["SQUARE]] [[OF] ["NUMOF]] ~
[[HOW OLD] ["WHAT]] [[IS EQUAL TO] ["IS]] ~
[[YEARS YOUNGER THAN] [[LESS THAN]]] [[YEARS OLDER THAN] ["PLUS]] ~
[[PERCENT LESS THAN] ["PERLESS]] [[LESS THAN] ["LESSTHAN]] ~
[[THESE] ["THE]] [[MORE THAN] ["PLUS]] ~
[[FIRST TWO NUMBERS] [[THE FIRST NUMBER AND THE SECOND NUMBER]]] ~
[[THREE NUMBERS] ~
[[THE FIRST NUMBER AND THE SECOND NUMBER AND THE THIRD NUMBER]]] ~
[[ONE HALF] [0.5]] [[TWICE] [[2 TIMES]]] ~
[[$ !NUMBER] [SE :NUMBER "DOLLARS]] [[CONSECUTIVE TO] [[1 PLUS]]] ~
[[LARGER THAN] ["PLUS]] [[PER CENT] ["PERCENT]] [[HOW MANY] ["HOWM]] ~
[[IS MU